Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

178

Games Picked

276

Number of predictions

68

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Cleveland Browns Houston Texans No 15 0.2206
2 Kansas City Chiefs Kansas City Chiefs Yes 49 0.7206
3 Dallas Cowboys Green Bay Packers No 13 0.1912
4 Detroit Lions Detroit Lions Yes 58 0.8529
5 Buffalo Bills Buffalo Bills Yes 54 0.7941
6 Philadelphia Eagles Tampa Bay Buccaneers No 18 0.2647

Individual Predictions

row

Individual Table

Individual Results
Week 19
Name Weekly # Correct Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5 Week 6 Week 7 Week 8 Week 9 Week 10 Week 11 Week 12 Week 13 Week 14 Week 15 Week 16 Week 17 Week 18 Week 19
Gabriel Quinones 9 11 12 12 6 9 6 11 NA 8 9 NA 9 8 9 10 NA 9 5 0.8333 16 0.6217 0.5235
Ryan Cvik 11 11 9 13 6 10 8 8 6 8 10 10 8 9 9 9 11 8 5 0.8333 19 0.6123 0.6123
Daniel Major 8 13 6 7 8 11 7 11 NA NA 9 NA 7 NA NA NA NA 7 5 0.8333 12 0.5858 0.3700
Trevor MACGAVIN 6 10 8 NA 6 7 4 NA 6 6 9 13 7 9 8 9 10 12 5 0.8333 17 0.5533 0.4951
Stephen Woolwine 8 13 9 NA NA 9 NA 11 11 NA 10 12 9 NA NA 9 NA 12 4 0.6667 12 0.6802 0.4296
George Sweet 9 11 10 12 7 10 10 NA 11 8 10 13 9 8 8 8 11 9 4 0.6667 18 0.6462 0.6122
Ramar Williams NA 11 11 9 8 8 6 12 NA 8 NA 13 9 6 11 NA 13 9 4 0.6667 15 0.6389 0.5044
Antonio Mitchell 10 12 NA 11 10 10 5 12 9 NA 10 12 NA 6 8 10 10 9 4 0.6667 16 0.6298 0.5304
Bradley Hobson 8 10 11 12 8 11 4 NA 8 9 9 12 NA 6 10 NA 11 NA 4 0.6667 15 0.6186 0.4884
Stephen Bush 7 10 10 9 7 10 6 12 NA 5 10 11 8 8 11 9 14 11 4 0.6667 18 0.6183 0.5858
Patrick Tynan 8 8 10 11 7 NA 5 11 10 7 11 13 8 5 12 10 12 9 4 0.6667 18 0.6169 0.5844
Shaun Dahl 8 8 10 10 7 9 5 13 9 8 NA NA 8 8 13 11 NA 10 4 0.6667 16 0.6130 0.5162
James Tierney 9 10 NA 10 10 12 7 10 8 9 9 10 8 8 7 11 8 10 4 0.6667 18 0.6107 0.5786
DAVID PLATE 8 NA 8 9 8 10 5 9 11 8 9 12 NA 7 13 NA 11 9 4 0.6667 16 0.6104 0.5140
Daniel Baller 6 12 11 9 8 9 3 10 8 9 10 9 8 9 9 9 9 10 4 0.6667 19 0.5870 0.5870
Steven Curtis NA NA 11 7 8 10 6 7 8 7 7 11 7 8 11 11 NA NA 4 0.6667 15 0.5802 0.4581
Robert Lynch 9 9 6 10 10 6 4 9 10 5 9 8 7 6 12 10 11 8 4 0.6667 19 0.5543 0.5543
Min Choi 6 7 9 11 7 10 5 13 7 5 NA NA NA NA NA NA NA NA 4 0.6667 11 0.5455 0.3158
Melissa Printup 8 NA 8 7 10 7 6 NA NA 5 9 9 NA 9 7 8 8 9 4 0.6667 15 0.5253 0.4147
Justin Crick 11 11 11 13 8 11 4 11 11 8 9 12 9 8 11 9 11 9 3 0.5000 19 0.6522 0.6522
William Schouviller 10 9 11 10 8 9 NA 13 10 9 9 10 10 6 11 10 12 10 3 0.5000 18 0.6464 0.6124
Jason Schattel 7 10 9 11 9 10 3 13 12 9 10 12 9 6 10 11 NA 11 3 0.5000 18 0.6346 0.6012
Ryan Wiggins 8 11 11 12 7 11 5 11 10 8 10 10 7 6 12 10 NA 12 3 0.5000 18 0.6308 0.5976
Cheryl Brown 10 12 11 9 6 9 6 10 8 9 8 12 8 8 11 11 11 11 3 0.5000 19 0.6268 0.6268
John Plaster 8 12 8 10 NA NA 6 9 7 10 9 7 8 8 10 10 12 13 3 0.5000 17 0.6073 0.5434
PABLO BURGOSRAMOS 9 11 10 12 7 12 6 8 9 7 10 NA 8 3 12 10 11 9 3 0.5000 18 0.6038 0.5720
Karen Coleman 7 10 NA 10 8 9 4 9 13 11 9 12 8 6 10 8 14 7 3 0.5000 18 0.6031 0.5714
MICHAEL BRANSON 8 11 10 12 9 10 4 11 10 7 8 NA 10 9 8 8 NA 9 3 0.5000 17 0.6025 0.5391
Terry Hardison 10 10 9 11 7 9 4 11 9 10 9 11 8 7 11 8 11 7 3 0.5000 19 0.5978 0.5978
James Small 8 8 13 9 8 10 8 10 12 6 10 9 5 7 9 8 11 11 3 0.5000 19 0.5978 0.5978
Bunnaro Sun 9 10 9 8 9 9 6 9 11 8 10 10 8 5 12 NA 9 10 3 0.5000 18 0.5962 0.5648
Aubrey Conn 9 12 8 11 9 9 4 11 11 8 7 12 8 5 9 10 NA 9 3 0.5000 18 0.5962 0.5648
Paul Presti 9 10 12 9 8 9 5 8 NA 9 9 NA 8 10 11 9 NA 8 3 0.5000 16 0.5957 0.5016
Walter Archambo 7 10 10 11 7 9 5 9 12 NA 8 11 9 5 10 10 11 9 3 0.5000 18 0.5954 0.5641
Amy Asberry 8 9 10 9 9 8 5 10 6 9 7 10 9 7 12 11 12 10 3 0.5000 19 0.5942 0.5942
Earl Dixon 9 11 8 12 5 NA 7 8 9 8 9 12 8 6 11 10 NA 9 3 0.5000 17 0.5918 0.5295
Robert Gelo 6 9 10 10 9 11 5 11 6 9 9 10 8 6 11 NA NA NA 3 0.5000 16 0.5833 0.4912
Charlene Redmer 9 9 NA 9 9 11 NA 10 8 7 8 NA 6 NA NA 10 NA 9 3 0.5000 13 0.5806 0.3973
Shawn Carden 9 12 6 9 8 9 5 10 9 8 9 12 7 6 10 11 10 7 3 0.5000 19 0.5797 0.5797
Kevin Kehoe 9 10 11 12 7 8 6 10 7 8 8 8 NA 6 9 8 12 9 3 0.5000 18 0.5741 0.5439
Manuel Vargas 10 9 11 12 7 10 6 12 5 5 7 8 9 7 10 NA 11 7 3 0.5000 18 0.5731 0.5429
Anthony Brinson 10 11 8 6 10 9 8 10 9 7 8 11 9 5 9 8 7 10 3 0.5000 19 0.5725 0.5725
Thomas Brenstuhl 10 NA 8 8 8 9 5 9 11 6 11 NA 8 5 11 NA NA 9 3 0.5000 15 0.5708 0.4506
Khalil Ibrahim 7 12 9 NA 7 10 6 10 9 5 7 11 5 7 11 11 NA 9 3 0.5000 17 0.5697 0.5097
Daniel Kuehl 6 10 8 11 7 9 7 12 7 6 10 11 8 6 9 9 NA 9 3 0.5000 18 0.5692 0.5392
Kevin Green 9 12 9 9 8 9 7 NA NA 6 10 11 4 7 6 8 13 9 3 0.5000 17 0.5691 0.5092
Rafael Torres 6 8 12 11 NA NA 6 NA 9 5 10 8 5 6 11 6 12 6 3 0.5000 16 0.5368 0.4520
Robert Martin 10 9 6 NA 9 9 6 9 NA 5 9 9 6 8 9 7 NA 8 3 0.5000 16 0.5304 0.4467
Thomas Mccoy NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 3 0.5000 1 0.5000 0.0263
Wayne Schofield NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 3 0.5000 1 0.5000 0.0263
Ryan Shipley 3 8 7 6 6 7 5 10 9 6 9 NA 5 6 11 8 9 7 3 0.5000 18 0.4808 0.4555
Anthony Bloss 8 10 11 12 10 10 5 9 9 8 9 11 10 6 11 9 13 10 2 0.3333 19 0.6268 0.6268
Vincent Scannelli 11 11 8 11 7 NA 5 9 12 10 10 NA 8 6 NA 11 NA NA 2 0.3333 14 0.6142 0.4526
Montee Brown 7 NA NA 9 9 11 6 12 11 8 10 12 8 6 11 10 10 9 2 0.3333 17 0.6138 0.5492
Brian Patterson 10 10 8 11 7 11 5 10 10 8 11 12 7 6 9 8 13 10 2 0.3333 19 0.6087 0.6087
Eric Hahn 9 13 7 9 8 10 6 9 10 6 11 12 9 6 10 8 12 10 2 0.3333 19 0.6051 0.6051
Michael Moss 10 NA 11 13 7 9 4 10 9 8 9 10 8 5 10 11 10 NA 2 0.3333 17 0.5984 0.5354
Matthew Schultz 8 NA 10 8 9 9 6 10 11 8 9 12 5 NA NA NA 10 10 2 0.3333 15 0.5962 0.4707
Jonathon Leslein 9 9 9 9 7 11 5 9 8 10 10 NA 9 5 10 9 10 13 2 0.3333 18 0.5923 0.5611
Derrick Elam NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 11 2 0.3333 2 0.5909 0.0622
Paul Shim 10 9 10 11 7 9 4 10 10 8 11 10 8 8 9 8 11 8 2 0.3333 19 0.5906 0.5906
Brian Hollmann 8 13 8 9 8 9 6 13 8 8 8 12 6 5 11 10 8 9 2 0.3333 19 0.5833 0.5833
Gregory Flint 6 11 NA 11 8 10 NA NA 9 5 8 NA 9 5 10 NA 10 NA 2 0.3333 13 0.5622 0.3847
Kristen White 7 13 8 11 6 7 7 10 8 6 10 7 8 7 8 NA 13 8 2 0.3333 18 0.5615 0.5319
Justin Thrift 9 8 9 8 9 7 5 11 7 6 10 NA 7 9 8 10 NA 8 2 0.3333 17 0.5451 0.4877
Cody Koerwitz 7 9 11 12 7 10 6 NA 9 9 10 10 9 6 13 NA NA 10 1 0.1667 16 0.6096 0.5133
Ronald Schmidt 11 13 11 8 8 11 5 9 8 8 7 NA 7 7 9 11 10 NA 1 0.1667 17 0.5902 0.5281
George Mancini 7 12 10 10 9 10 6 NA 7 9 9 11 5 7 NA 10 7 6 1 0.1667 17 0.5574 0.4987
Michael Edmunds 10 12 10 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 4 0.6774 0.1426
Kevin O'NEILL 8 11 11 13 7 NA NA 10 NA NA NA NA NA NA NA NA NA NA NA 0.0000 6 0.6522 0.2060
Shelly Bailey 9 10 NA 10 8 11 6 NA 13 7 9 13 NA NA NA NA NA NA NA 0.0000 10 0.6486 0.3414
Chris Papageorge 11 11 11 10 8 9 5 11 12 8 8 NA 10 NA 10 9 NA 9 NA 0.0000 15 0.6368 0.5027
Sarah Sweet 9 12 12 9 8 NA 6 11 11 10 8 9 6 NA NA NA NA NA NA 0.0000 12 0.6307 0.3983
Daniel Halse 8 9 10 NA NA NA 7 11 NA 7 7 NA 8 NA 11 10 13 12 NA 0.0000 12 0.6278 0.3965
Carlos Caceres 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.6250 0.0329
WAYNE SCHOFIELD 12 9 7 NA 8 NA 5 10 7 NA 10 NA 8 8 12 NA NA 12 NA 0.0000 12 0.6102 0.3854
Keithon Corpening 8 NA NA NA NA NA NA 11 12 9 8 10 6 8 12 9 10 8 NA 0.0000 12 0.6099 0.3852
Donald Park 8 12 7 9 NA NA 6 10 11 NA 9 NA NA NA NA NA NA NA NA 0.0000 8 0.6050 0.2547
Yiming Hu 9 10 8 12 7 9 6 9 10 8 10 NA 7 6 9 9 12 10 NA 0.0000 17 0.5945 0.5319
James Blejski 8 11 10 14 NA 9 7 12 7 6 9 9 9 6 7 9 NA NA NA 0.0000 15 0.5938 0.4688
Pamela AUGUSTINE 11 13 6 9 6 9 5 10 9 NA 10 11 8 6 11 9 NA NA NA 0.0000 15 0.5938 0.4688
William Sherman 8 11 10 10 6 NA 5 NA 9 NA 9 NA NA NA NA NA NA NA NA 0.0000 8 0.5812 0.2447
Brandon Parks 8 8 NA NA 9 9 5 9 9 9 8 10 10 10 9 9 NA 8 NA 0.0000 15 0.5804 0.4582
Rahmatullah Sharifi 11 9 8 11 8 8 5 NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 7 0.5769 0.2125
Steven Webster 8 8 6 8 9 8 6 10 10 8 10 NA 7 6 12 NA NA NA NA 0.0000 14 0.5631 0.4149
Jamal Willis 8 10 NA NA NA NA NA 9 NA NA NA NA NA NA NA NA NA NA NA 0.0000 3 0.5625 0.0888
Jason James 9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0296
TYREE BUNDY 8 8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 11 NA NA 0.0000 3 0.5625 0.0888
Michael Beck 9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0296
THOMAS MCCOY 8 10 9 7 8 9 7 11 7 7 NA 10 5 8 NA 9 9 8 NA 0.0000 16 0.5500 0.4632
DERRICK ELAM 6 9 11 10 10 7 NA 5 7 7 6 NA 7 9 NA 12 NA NA NA 0.0000 13 0.5492 0.3758
Alexander Santillan 5 NA 8 9 5 11 6 11 8 9 7 9 8 8 NA NA NA NA NA 0.0000 13 0.5474 0.3745
Derrick Zantt 11 6 7 NA 6 9 6 11 NA NA NA NA NA NA NA NA NA NA NA 0.0000 7 0.5385 0.1984
Rodney Cathcart NA NA NA NA NA NA NA NA NA NA NA NA 7 NA NA NA NA NA NA 0.0000 1 0.5385 0.0283
Cherylynn Vidal 10 9 9 12 9 7 4 6 9 7 NA 9 6 5 9 10 NA 8 NA 0.0000 16 0.5375 0.4526
David Spielman 8 NA 11 NA NA NA 3 NA 7 8 9 NA NA NA NA 8 NA 8 NA 0.0000 8 0.5299 0.2231
Craig Webster NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 8 NA 0.0000 1 0.5000 0.0263
Edward Ford 6 8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 2 0.4375 0.0461

Individual Plots

Season Leaderboard

Season Leaderboard (Season Percent)
Week 19
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Stephen Woolwine 1 12 0.6802 0.4296
2 Michael Edmunds 0 4 0.6774 0.1426
3 Justin Crick 0 19 0.6522 0.6522
3 Kevin O'NEILL 0 6 0.6522 0.2060
5 Shelly Bailey 2 10 0.6486 0.3414
6 William Schouviller 2 18 0.6464 0.6124
7 George Sweet 2 18 0.6462 0.6122
8 Ramar Williams 1 15 0.6389 0.5044
9 Chris Papageorge 1 15 0.6368 0.5027
10 Jason Schattel 1 18 0.6346 0.6012
11 Ryan Wiggins 0 18 0.6308 0.5976
12 Sarah Sweet 0 12 0.6307 0.3983
13 Antonio Mitchell 1 16 0.6298 0.5304
14 Daniel Halse 0 12 0.6278 0.3965
15 Anthony Bloss 2 19 0.6268 0.6268
15 Cheryl Brown 0 19 0.6268 0.6268
17 Carlos Caceres 0 1 0.6250 0.0329
18 Gabriel Quinones 1 16 0.6217 0.5235
19 Bradley Hobson 0 15 0.6186 0.4884
20 Stephen Bush 1 18 0.6183 0.5858
21 Patrick Tynan 2 18 0.6169 0.5844
22 Vincent Scannelli 0 14 0.6142 0.4526
23 Montee Brown 0 17 0.6138 0.5492
24 Shaun Dahl 2 16 0.6130 0.5162
25 Ryan Cvik 1 19 0.6123 0.6123
26 James Tierney 2 18 0.6107 0.5786
27 DAVID PLATE 1 16 0.6104 0.5140
28 WAYNE SCHOFIELD 1 12 0.6102 0.3854
29 Keithon Corpening 0 12 0.6099 0.3852
30 Cody Koerwitz 1 16 0.6096 0.5133
31 Brian Patterson 1 19 0.6087 0.6087
32 John Plaster 1 17 0.6073 0.5434
33 Eric Hahn 2 19 0.6051 0.6051
34 Donald Park 0 8 0.6050 0.2547
35 PABLO BURGOSRAMOS 1 18 0.6038 0.5720
36 Karen Coleman 3 18 0.6031 0.5714
37 MICHAEL BRANSON 1 17 0.6025 0.5391
38 Michael Moss 0 17 0.5984 0.5354
39 James Small 1 19 0.5978 0.5978
39 Terry Hardison 0 19 0.5978 0.5978
41 Aubrey Conn 0 18 0.5962 0.5648
41 Bunnaro Sun 0 18 0.5962 0.5648
41 Matthew Schultz 0 15 0.5962 0.4707
44 Paul Presti 1 16 0.5957 0.5016
45 Walter Archambo 0 18 0.5954 0.5641
46 Yiming Hu 0 17 0.5945 0.5319
47 Amy Asberry 0 19 0.5942 0.5942
48 James Blejski 1 15 0.5938 0.4688
48 Pamela AUGUSTINE 1 15 0.5938 0.4688
50 Jonathon Leslein 1 18 0.5923 0.5611
51 Earl Dixon 0 17 0.5918 0.5295
52 Derrick Elam 0 2 0.5909 0.0622
53 Paul Shim 1 19 0.5906 0.5906
54 Ronald Schmidt 1 17 0.5902 0.5281
55 Daniel Baller 0 19 0.5870 0.5870
56 Daniel Major 2 12 0.5858 0.3700
57 Brian Hollmann 2 19 0.5833 0.5833
57 Robert Gelo 0 16 0.5833 0.4912
59 William Sherman 0 8 0.5812 0.2447
60 Charlene Redmer 0 13 0.5806 0.3973
61 Brandon Parks 2 15 0.5804 0.4582
62 Steven Curtis 0 15 0.5802 0.4581
63 Shawn Carden 0 19 0.5797 0.5797
64 Rahmatullah Sharifi 0 7 0.5769 0.2125
65 Kevin Kehoe 0 18 0.5741 0.5439
66 Manuel Vargas 0 18 0.5731 0.5429
67 Anthony Brinson 1 19 0.5725 0.5725
68 Thomas Brenstuhl 1 15 0.5708 0.4506
69 Khalil Ibrahim 0 17 0.5697 0.5097
70 Daniel Kuehl 0 18 0.5692 0.5392
71 Kevin Green 0 17 0.5691 0.5092
72 Steven Webster 0 14 0.5631 0.4149
73 Jamal Willis 0 3 0.5625 0.0888
73 Jason James 0 1 0.5625 0.0296
73 Michael Beck 0 1 0.5625 0.0296
73 TYREE BUNDY 0 3 0.5625 0.0888
77 Gregory Flint 0 13 0.5622 0.3847
78 Kristen White 1 18 0.5615 0.5319
79 George Mancini 0 17 0.5574 0.4987
80 Robert Lynch 1 19 0.5543 0.5543
81 Trevor MACGAVIN 2 17 0.5533 0.4951
82 THOMAS MCCOY 0 16 0.5500 0.4632
83 DERRICK ELAM 2 13 0.5492 0.3758
84 Alexander Santillan 0 13 0.5474 0.3745
85 Min Choi 1 11 0.5455 0.3158
86 Justin Thrift 0 17 0.5451 0.4877
87 Derrick Zantt 0 7 0.5385 0.1984
87 Rodney Cathcart 0 1 0.5385 0.0283
89 Cherylynn Vidal 0 16 0.5375 0.4526
90 Rafael Torres 0 16 0.5368 0.4520
91 Robert Martin 0 16 0.5304 0.4467
92 David Spielman 0 8 0.5299 0.2231
93 Melissa Printup 1 15 0.5253 0.4147
94 Craig Webster 0 1 0.5000 0.0263
94 Thomas Mccoy 0 1 0.5000 0.0263
94 Wayne Schofield 0 1 0.5000 0.0263
97 Ryan Shipley 0 18 0.4808 0.4555
98 Edward Ford 0 2 0.4375 0.0461

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 19
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Justin Crick 0 19 0.6522 0.6522
2 Anthony Bloss 2 19 0.6268 0.6268
2 Cheryl Brown 0 19 0.6268 0.6268
4 William Schouviller 2 18 0.6464 0.6124
5 Ryan Cvik 1 19 0.6123 0.6123
6 George Sweet 2 18 0.6462 0.6122
7 Brian Patterson 1 19 0.6087 0.6087
8 Eric Hahn 2 19 0.6051 0.6051
9 Jason Schattel 1 18 0.6346 0.6012
10 James Small 1 19 0.5978 0.5978
10 Terry Hardison 0 19 0.5978 0.5978
12 Ryan Wiggins 0 18 0.6308 0.5976
13 Amy Asberry 0 19 0.5942 0.5942
14 Paul Shim 1 19 0.5906 0.5906
15 Daniel Baller 0 19 0.5870 0.5870
16 Stephen Bush 1 18 0.6183 0.5858
17 Patrick Tynan 2 18 0.6169 0.5844
18 Brian Hollmann 2 19 0.5833 0.5833
19 Shawn Carden 0 19 0.5797 0.5797
20 James Tierney 2 18 0.6107 0.5786
21 Anthony Brinson 1 19 0.5725 0.5725
22 PABLO BURGOSRAMOS 1 18 0.6038 0.5720
23 Karen Coleman 3 18 0.6031 0.5714
24 Aubrey Conn 0 18 0.5962 0.5648
24 Bunnaro Sun 0 18 0.5962 0.5648
26 Walter Archambo 0 18 0.5954 0.5641
27 Jonathon Leslein 1 18 0.5923 0.5611
28 Robert Lynch 1 19 0.5543 0.5543
29 Montee Brown 0 17 0.6138 0.5492
30 Kevin Kehoe 0 18 0.5741 0.5439
31 John Plaster 1 17 0.6073 0.5434
32 Manuel Vargas 0 18 0.5731 0.5429
33 Daniel Kuehl 0 18 0.5692 0.5392
34 MICHAEL BRANSON 1 17 0.6025 0.5391
35 Michael Moss 0 17 0.5984 0.5354
36 Kristen White 1 18 0.5615 0.5319
36 Yiming Hu 0 17 0.5945 0.5319
38 Antonio Mitchell 1 16 0.6298 0.5304
39 Earl Dixon 0 17 0.5918 0.5295
40 Ronald Schmidt 1 17 0.5902 0.5281
41 Gabriel Quinones 1 16 0.6217 0.5235
42 Shaun Dahl 2 16 0.6130 0.5162
43 DAVID PLATE 1 16 0.6104 0.5140
44 Cody Koerwitz 1 16 0.6096 0.5133
45 Khalil Ibrahim 0 17 0.5697 0.5097
46 Kevin Green 0 17 0.5691 0.5092
47 Ramar Williams 1 15 0.6389 0.5044
48 Chris Papageorge 1 15 0.6368 0.5027
49 Paul Presti 1 16 0.5957 0.5016
50 George Mancini 0 17 0.5574 0.4987
51 Trevor MACGAVIN 2 17 0.5533 0.4951
52 Robert Gelo 0 16 0.5833 0.4912
53 Bradley Hobson 0 15 0.6186 0.4884
54 Justin Thrift 0 17 0.5451 0.4877
55 Matthew Schultz 0 15 0.5962 0.4707
56 James Blejski 1 15 0.5938 0.4688
56 Pamela AUGUSTINE 1 15 0.5938 0.4688
58 THOMAS MCCOY 0 16 0.5500 0.4632
59 Brandon Parks 2 15 0.5804 0.4582
60 Steven Curtis 0 15 0.5802 0.4581
61 Ryan Shipley 0 18 0.4808 0.4555
62 Cherylynn Vidal 0 16 0.5375 0.4526
62 Vincent Scannelli 0 14 0.6142 0.4526
64 Rafael Torres 0 16 0.5368 0.4520
65 Thomas Brenstuhl 1 15 0.5708 0.4506
66 Robert Martin 0 16 0.5304 0.4467
67 Stephen Woolwine 1 12 0.6802 0.4296
68 Steven Webster 0 14 0.5631 0.4149
69 Melissa Printup 1 15 0.5253 0.4147
70 Sarah Sweet 0 12 0.6307 0.3983
71 Charlene Redmer 0 13 0.5806 0.3973
72 Daniel Halse 0 12 0.6278 0.3965
73 WAYNE SCHOFIELD 1 12 0.6102 0.3854
74 Keithon Corpening 0 12 0.6099 0.3852
75 Gregory Flint 0 13 0.5622 0.3847
76 DERRICK ELAM 2 13 0.5492 0.3758
77 Alexander Santillan 0 13 0.5474 0.3745
78 Daniel Major 2 12 0.5858 0.3700
79 Shelly Bailey 2 10 0.6486 0.3414
80 Min Choi 1 11 0.5455 0.3158
81 Donald Park 0 8 0.6050 0.2547
82 William Sherman 0 8 0.5812 0.2447
83 David Spielman 0 8 0.5299 0.2231
84 Rahmatullah Sharifi 0 7 0.5769 0.2125
85 Kevin O'NEILL 0 6 0.6522 0.2060
86 Derrick Zantt 0 7 0.5385 0.1984
87 Michael Edmunds 0 4 0.6774 0.1426
88 Jamal Willis 0 3 0.5625 0.0888
88 TYREE BUNDY 0 3 0.5625 0.0888
90 Derrick Elam 0 2 0.5909 0.0622
91 Edward Ford 0 2 0.4375 0.0461
92 Carlos Caceres 0 1 0.6250 0.0329
93 Jason James 0 1 0.5625 0.0296
93 Michael Beck 0 1 0.5625 0.0296
95 Rodney Cathcart 0 1 0.5385 0.0283
96 Craig Webster 0 1 0.5000 0.0263
96 Thomas Mccoy 0 1 0.5000 0.0263
96 Wayne Schofield 0 1 0.5000 0.0263

Data

---
title: "2023 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

```

```{r Reading in our picks files, include=FALSE}
current_week = 19 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2023 NFL Week 1.csv")
week_2 = read_csv("./CSV_Data_Files/2023 NFL Week 2.csv")
week_3 = read_csv("./CSV_Data_Files/2023 NFL Week 3.csv")
week_4 = read_csv("./CSV_Data_Files/2023 NFL Week 4.csv")
week_5 = read_csv("./CSV_Data_Files/2023 NFL Week 5.csv")
week_6 = read_csv("./CSV_Data_Files/2023 NFL Week 6.csv")
week_7 = read_csv("./CSV_Data_Files/2023 NFL Week 7.csv")
week_8 = read_csv("./CSV_Data_Files/2023 NFL Week 8.csv")
week_9 = read_csv("./CSV_Data_Files/2023 NFL Week 9.csv")
week_10 = read_csv("./CSV_Data_Files/2023 NFL Week 10.csv")
week_11 = read_csv("./CSV_Data_Files/2023 NFL Week 11.csv")
week_12 = read_csv("./CSV_Data_Files/2023 NFL Week 12.csv")
week_13 = read_csv("./CSV_Data_Files/2023 NFL Week 13.csv")
week_14 = read_csv("./CSV_Data_Files/2023 NFL Week 14.csv")
week_15 = read_csv("./CSV_Data_Files/2023 NFL Week 15.csv")
week_16 = read_csv("./CSV_Data_Files/2023 NFL Week 16.csv")
week_17 = read_csv("./CSV_Data_Files/2023 NFL Week 17.csv")
week_18 = read_csv("./CSV_Data_Files/2023 NFL Week 18.csv")
week_19 = read_csv("./CSV_Data_Files/2023 NFL Wild Card.csv")
# week_20 = read_csv("./CSV_Data_Files/2023 NFL Divisional Round.csv")
# week_21 = read_csv("./CSV_Data_Files/2023 NFL Conference Round.csv")
# week_22 = read_csv("./CSV_Data_Files/2023 NFL Super Bowl.csv")

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2023 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7, week_8, week_9, week_10, week_11, week_12, week_13, week_14, week_15, week_16, week_17 , week_18, week_19) #, week_20, week_21) #add in the additional weeks
# odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))

```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, echo=FALSE, out.width = "100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

### Individual Plots
```{r, out.width="100%"}
ggplotly(inst_indiv_plots)
```

### Season Leaderboard
```{r, out.width="100%"}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, out.width="100%"}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```